home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / packages / vc-hooks.el < prev    next >
Encoding:
Text File  |  1995-08-11  |  19.5 KB  |  535 lines
  1. ;;; vc-hooks.el --- resident support for version-control
  2.  
  3. ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
  4. ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
  5.  
  6. ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
  7. ;; Maintainer: ttn@netcom.com
  8. ;; Version: 5.3 + CVS hacks by ceder@lysator.liu.se made in Jan-Feb 1994.
  9. ;;
  10. ;; XEmacs fixes, CVS fixes, and general improvements
  11. ;; by Jonathan Stigelman <Stig@hackvan.com>
  12.  
  13. ;; This file is part of XEmacs.
  14.  
  15. ;; XEmacs is free software; you can redistribute it and/or modify it
  16. ;; under the terms of the GNU General Public License as published by
  17. ;; the Free Software Foundation; either version 2, or (at your option)
  18. ;; any later version.
  19.  
  20. ;; XEmacs is distributed in the hope that it will be useful, but
  21. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  22. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  23. ;; General Public License for more details.
  24.  
  25. ;; You should have received a copy of the GNU General Public License
  26. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  27. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  28.  
  29. ;;; Synched up with: FSF 19.28.
  30.  
  31. ;;; Commentary:
  32.  
  33. ;; See the commentary of vc.el.
  34.  
  35. ;;; Code:
  36.  
  37. (defvar vc-master-templates
  38.   '(("%sRCS/%s,v" . RCS) ("%s%s,v" . RCS) ("%sRCS/%s" . RCS)
  39.     ("%sSCCS/s.%s" . SCCS) ("%ss.%s". SCCS)
  40.     vc-find-cvs-master)
  41.   "*Where to look for version-control master files.
  42. The first pair corresponding to a given back end is used as a template
  43. when creating new masters.")
  44.  
  45. (defvar vc-make-backup-files nil
  46.   "*If non-nil, backups of registered files are made as with other files.
  47. If nil (the default), files covered by version control don't get backups.")
  48.  
  49. (defvar vc-display-status t
  50.   "*If non-nil, display revision number and lock status in modeline.
  51. Otherwise, not displayed.")
  52.  
  53. ;; Tell Emacs about this new kind of minor mode
  54. (if (not (assoc 'vc-mode minor-mode-alist))
  55.     (setq minor-mode-alist (cons '(vc-mode vc-mode)
  56.                  minor-mode-alist)))
  57.  
  58. (defvar vc-mode nil)            ; used for modeline flag
  59. (make-variable-buffer-local 'vc-mode)
  60. (put 'vc-mode 'permanent-local t)
  61.  
  62. ;; We need a notion of per-file properties because the version
  63. ;; control state of a file is expensive to derive --- we don't
  64. ;; want to recompute it even on every find.
  65.  
  66. (defmacro vc-error-occurred (&rest body)
  67.   (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
  68.  
  69. (defvar vc-file-prop-obarray (make-vector 17 0)
  70.   "Obarray for per-file properties.")
  71.  
  72. (defun vc-file-setprop (file property value)
  73.   ;; set per-file property
  74.   (put (intern file vc-file-prop-obarray) property value))
  75.  
  76. (defun vc-file-getprop (file property)
  77.   ;; get per-file property
  78.   (get (intern file vc-file-prop-obarray) property))
  79.  
  80. ;;; actual version-control code starts here
  81.  
  82. (defun vc-registered (file)
  83.   (let (handler)
  84.     (if (boundp 'file-name-handler-alist)
  85.     (setq handler (find-file-name-handler file 'vc-registered)))
  86.     (if handler
  87.     (funcall handler 'vc-registered file)
  88.       ;; Search for a master corresponding to the given file
  89.       (let ((dirname (or (file-name-directory file) ""))
  90.         (basename (file-name-nondirectory file)))
  91.     (catch 'found
  92.       (mapcar
  93.        (function (lambda (s)
  94.                (if (atom s)
  95.                (funcall s dirname basename)
  96.              (let ((trial (format (car s) dirname basename)))
  97.                (if (and (file-exists-p trial)
  98.                     ;; Make sure the file we found with name
  99.                     ;; TRIAL is not the source file itself.
  100.                     ;; That can happen with RCS-style names
  101.                     ;; if the file name is truncated
  102.                     ;; (e.g. to 14 chars).  See if either
  103.                     ;; directory or attributes differ.
  104.                     (or (not (string= dirname
  105.                               (file-name-directory trial)))
  106.                     (not (equal
  107.                           (file-attributes file)
  108.                           (file-attributes trial)))))
  109.                    (throw 'found (cons trial (cdr s))))))))
  110.        vc-master-templates)
  111.       nil)))))
  112.  
  113. (defun vc-find-cvs-master (dirname basename)
  114.   ;; Check if DIRNAME/BASENAME is handled by CVS.
  115.   ;; If it is, do a (throw 'found (cons MASTER 'CVS)).
  116.   ;; Note: If the file is ``cvs add''ed but not yet ``cvs commit''ed 
  117.   ;; the MASTER will not actually exist yet.  The other parts of VC
  118.   ;; checks for this condition.  This function returns something random if 
  119.   ;; DIRNAME/BASENAME is not handled by CVS.
  120.   (and (string= "" dirname) (setq dirname default-directory))
  121.   (if (and (file-directory-p (concat dirname "CVS/"))
  122.        (file-readable-p (concat dirname "CVS/Entries")))
  123.       (let ((fname (concat dirname basename))
  124.         sbuf rev)
  125.     (unwind-protect
  126.         (save-excursion
  127.           (set-buffer (generate-new-buffer " vc-scratch"))
  128.           (setq sbuf (current-buffer))
  129.           (insert-file-contents (concat dirname "CVS/Entries"))
  130.           (cond
  131.            ((re-search-forward
  132.          (concat "^/" (regexp-quote basename) "/\\([0-9.]*\\)/.*/\\(T\\([^/\n]+\\)\\)?$")
  133.          nil t)
  134.         ;; We found it.  Store version number, and branch tag
  135.         (setq rev (buffer-substring (match-beginning 1)
  136.                         (match-end 1)))
  137.         (vc-file-setprop fname 'vc-your-latest-version rev)
  138.         ;; XEmacs - we put something useful in the modeline
  139.         (vc-file-setprop fname 'sticky-tag
  140.                  (cond ((string= "0" rev) "newfile")
  141.                        ((match-beginning 3)
  142.                     (buffer-substring (match-beginning 3)
  143.                               (match-end 3)))
  144.                        (t "main")))
  145.         (erase-buffer)
  146.         (insert-file-contents (concat dirname "CVS/Repository"))
  147.         (let ((master
  148.                (concat (file-name-as-directory 
  149.                 (buffer-substring (point-min)
  150.                           (1- (point-max))))
  151.                    basename
  152.                    ",v")))
  153.           (throw 'found (cons master 'CVS))))))
  154.       (kill-buffer sbuf)))))
  155.  
  156. (defun vc-name (file)
  157.   "Return the master name of a file, nil if it is not registered."
  158.   (or (vc-file-getprop file 'vc-name)
  159.       (let ((name-and-type (vc-registered file)))
  160.     (if name-and-type
  161.         (progn
  162.           (vc-file-setprop file 'vc-backend (cdr name-and-type))
  163.           (vc-file-setprop file 'vc-name (car name-and-type)))))))
  164.  
  165. (defun vc-backend-deduce (file)
  166.   "Return the version-control type of a file, nil if it is not registered."
  167.   (and file
  168.        (or (vc-file-getprop file 'vc-backend)
  169.            (let ((name-and-type (vc-registered file)))
  170.          (if name-and-type
  171.          (progn
  172.            (vc-file-setprop file 'vc-name (car name-and-type))
  173.            (vc-file-setprop file 'vc-backend (cdr name-and-type))))))))
  174.  
  175. (defun vc-toggle-read-only (&optional verbose)
  176.   "Change read-only status of current buffer, perhaps via version control.
  177. If the buffer is visiting a file registered with a form of version control
  178. that locks files by making them read-only (i.e.: not CVS), then check the
  179. file in or out.  Otherwise, just change the read-only flag of the buffer.
  180.  
  181. If you provide a prefix argument, we pass it on to `vc-next-action'."
  182.   (interactive "P")
  183.   (let ((vc-type (vc-backend-deduce (buffer-file-name))))
  184.     (cond ((and vc-type
  185.         buffer-read-only
  186.         (file-writable-p buffer-file-name)
  187.         (/= 0 (user-uid)))
  188.        ;; XEmacs - The buffer isn't read-only because it's locked, so
  189.        ;; keep vc out of this...
  190.        (toggle-read-only))
  191.       ((and vc-type (not (eq 'CVS  vc-type)))
  192.        (vc-next-action verbose))
  193.       (t
  194.        (toggle-read-only)))
  195.     ))
  196.  
  197. (define-key global-map "\C-x\C-q" 'vc-toggle-read-only)
  198.  
  199. (defun vc-file-owner (file)
  200.   ;; XEmacs - vc-locking-user is just WAY too slow.
  201.   (let* ((fa (file-attributes file)))
  202.     (cond ((eq ?w (aref (nth 8 fa) 2))    ; -rw-r--r--
  203.        ;; #### - if it's writable, we trust unix...dumb move?
  204.        (user-login-name (nth 2 fa)))
  205.       (t
  206.        ;; big slowness here...
  207.        (require 'vc)
  208.        (vc-locking-user file)
  209.        ))))
  210.  
  211. (defun vc-mode-line (file &optional label)
  212.   "Set `vc-mode' to display type of version control for FILE.
  213. The value is set in the current buffer, which should be the buffer
  214. visiting FILE.  Second optional arg LABEL is put in place of version
  215. control system name."
  216.   (interactive (list buffer-file-name nil))
  217.   (if file
  218.       (let ((vc-type (vc-backend-deduce file)))
  219.     (setq vc-mode
  220.           (if vc-type
  221.           (concat " " (or label (symbol-name vc-type))
  222.               (if vc-display-status
  223.                   (vc-status file vc-type)))))
  224.     ;; Even root shouldn't modify a registered file without
  225.     ;; locking it first.
  226.     (and vc-type
  227.          (not (string= (user-login-name) (vc-file-owner file)))
  228.          (setq buffer-read-only t))
  229.     (and (null vc-type)
  230.          (file-symlink-p file)
  231.          (let ((link-type (vc-backend-deduce (file-symlink-p file))))
  232.            (if link-type
  233.            (message
  234.             "Warning: symbolic link to %s-controlled source file"
  235.             link-type))))
  236.     (redraw-modeline)
  237.     ;;(set-buffer-modified-p (buffer-modified-p))  ;;use this if Emacs 18
  238.     vc-type)))
  239.  
  240. (defun vc-status (file vc-type)
  241.   ;; Return string for placement in modeline by `vc-mode-line'.
  242.   ;; If FILE is not registered, return nil.
  243.   ;; If FILE is registered but not locked, return " REV" if there is a head
  244.   ;; revision and " @@" otherwise.
  245.   ;; If FILE is locked then return all locks in a string of the
  246.   ;; form " LOCKER1:REV1 LOCKER2:REV2 ...", where "LOCKERi:" is empty if you
  247.   ;; are the locker, and otherwise is the name of the locker followed by ":".
  248.  
  249.   ;; Algorithm: 
  250.  
  251.   ;; Check for master file corresponding to FILE being visited.
  252.   ;; 
  253.   ;; RCS: Insert the first few characters of the master file into a
  254.   ;; work buffer.  Search work buffer for "locks...;" phrase; if not
  255.   ;; found, then keep inserting more characters until the phrase is
  256.   ;; found.  Extract the locks, and remove control characters
  257.   ;; separating them, like newlines; the string " user1:revision1
  258.   ;; user2:revision2 ..." is returned.
  259.   ;;
  260.   ;; SCCS: Check if the p-file exists.  If it does, read it and
  261.   ;; extract the locks, giving them the right format.  Else use prs to
  262.   ;; find the revision number.
  263.   ;;
  264.   ;; CVS: vc-find-cvs-master has already stored the current revision
  265.   ;; number and sticky-tag for the file.  XEmacs displays the sticky-tag.
  266.   
  267.   ;; Limitations:
  268.  
  269.   ;; The output doesn't show which version you are actually looking at.
  270.   ;; The modeline can get quite cluttered when there are multiple locks.
  271.   ;; The head revision is probably not what you want if you've used `rcs -b'.
  272.  
  273.   (let ((master (vc-name file))
  274.     found
  275.     status)
  276.  
  277.     ;; If master file exists, then parse its contents, otherwise we
  278.     ;; return the nil value of this if form.
  279.     (if (and master vc-type)
  280.         (save-excursion
  281.  
  282.           ;; Create work buffer.
  283.           (set-buffer (get-buffer-create " *vc-status*"))
  284.           (setq buffer-read-only nil
  285.                 default-directory (file-name-directory master))
  286.           (erase-buffer)
  287.  
  288.       ;; Set the `status' var to the return value.
  289.       (cond
  290.  
  291.        ;; RCS code.
  292.        ((eq vc-type 'RCS)
  293.         ;; Check if we have enough of the header.
  294.         ;; If not, then keep including more.
  295.             (while
  296.         (not (or found
  297.              (let ((s (buffer-size)))
  298.                (goto-char (1+ s))
  299.                (zerop (car (cdr (insert-file-contents
  300.                          master nil s (+ s 8192))))))))
  301.           (beginning-of-line)
  302.           (setq found (re-search-forward "^locks\\([^;]*\\);" nil t)))
  303.  
  304.         (if found
  305.         ;; Clean control characters and self-locks from text.
  306.         (let* ((lock-pattern
  307.             (concat "[ \b\t\n\v\f\r]+\\("
  308.                 (regexp-quote (user-login-name))
  309.                                 ":\\)?"))
  310.                (locks
  311.             (save-restriction
  312.               (narrow-to-region (match-beginning 1) (match-end 1))
  313.               (goto-char (point-min))
  314.               (while (re-search-forward lock-pattern nil t)
  315.                 (replace-match (if (eobp) "" ":") t t))
  316.               (buffer-string))))
  317.           (setq status
  318.             (if (not (string-equal locks ""))
  319.                 locks
  320.               (goto-char (point-min))
  321.               (if (looking-at "head[ \b\t\n\v\f\r]+\\([.0-9]+\\)")
  322.                   (concat "-"
  323.                       (buffer-substring (match-beginning 1)
  324.                             (match-end 1)))
  325.                 " @@"))))))
  326.  
  327.        ;; SCCS code.
  328.            ((eq vc-type 'SCCS)
  329.         ;; Build the name of the p-file and put it in the work buffer.
  330.         (insert master)
  331.         (search-backward "/s.")
  332.         (delete-char 2)
  333.         (insert "/p")
  334.         (if (not (file-exists-p (buffer-string)))
  335.         ;; No lock.
  336.         (let ((exec-path (if (boundp 'vc-path) (append exec-path vc-path)
  337.                    exec-path)))
  338.           (erase-buffer)
  339.                   (insert "-")
  340.           (if (zerop (call-process "prs" nil t nil "-d:I:" master))
  341.               (setq status (buffer-substring 1 (1- (point-max))))))
  342.           ;; Locks exist.
  343.           (insert-file-contents (buffer-string) nil nil nil t)
  344.           (while (looking-at "[^ ]+ \\([^ ]+\\) \\([^ ]+\\).*\n")
  345.         (replace-match " \\2:\\1"))
  346.           (setq status (buffer-string))
  347.           (aset status 0 ?:)))
  348.        ;; CVS code.
  349.        ((eq vc-type 'CVS)
  350.         ;; sticky-tag is initialized by vc-backend-deduce
  351.         (setq status (concat ":" (vc-file-getprop file 'sticky-tag) "-"
  352.                  (vc-file-getprop file 'vc-your-latest-version)
  353.                  ))
  354.         ))
  355.  
  356.       ;; Clean work buffer.
  357.       (erase-buffer)
  358.           (set-buffer-modified-p nil)
  359.       status))))
  360.  
  361. ;;; install a call to the above as a find-file hook
  362. (defun vc-find-file-hook ()
  363.   ;; Recompute whether file is version controlled,
  364.   ;; if user has killed the buffer and revisited.
  365.   (if buffer-file-name
  366.       (vc-file-setprop buffer-file-name 'vc-backend nil))
  367.   (if (and (vc-mode-line buffer-file-name) (not vc-make-backup-files))
  368.       (progn
  369.     ;; Use this variable, not make-backup-files,
  370.     ;; because this is for things that depend on the file name.
  371.     (set (make-local-variable 'backup-inhibited) t))))
  372.  
  373. (add-hook 'find-file-hooks 'vc-find-file-hook)
  374.  
  375. ;;; more hooks, this time for file-not-found
  376. (defun vc-file-not-found-hook ()
  377.   "When file is not found, try to check it out from RCS or SCCS.
  378. Returns t if checkout was successful, nil otherwise."
  379.   (if (vc-backend-deduce buffer-file-name)
  380.       (save-excursion
  381.     (require 'vc)
  382.     (not (vc-error-occurred (vc-checkout buffer-file-name))))))
  383.  
  384. (add-hook 'find-file-not-found-hooks 'vc-file-not-found-hook)
  385.  
  386. ;;; Now arrange for bindings and autoloading of the main package.
  387. ;;; Bindings for this have to go in the global map, as we'll often
  388. ;;; want to call them from random buffers.
  389.  
  390. ; XEmacs - this is preloaded.  let's not be obtuse!
  391. (defconst vc-prefix-map
  392.   (let ((map (make-sparse-keymap)))
  393.     (set-keymap-name map 'vc-prefix-map) 
  394.     (define-key map "a" 'vc-update-change-log)
  395.     (define-key map "c" 'vc-cancel-version)
  396.     (define-key map "d" 'vc-directory)
  397.     (define-key map "h" 'vc-insert-headers)
  398.     (define-key map "i" 'vc-register)
  399.     (define-key map "l" 'vc-print-log)
  400.     (define-key map "r" 'vc-retrieve-snapshot)
  401.     (define-key map "s" 'vc-create-snapshot)
  402.     (define-key map "u" 'vc-revert-buffer)
  403.     (define-key map "v" 'vc-next-action)
  404.     (define-key map "=" 'vc-diff)
  405.     (define-key map "?" 'vc-file-status) ; XEmacs - this doesn't fit elsewhere
  406.     (define-key map "~" 'vc-version-other-window)
  407.     (global-set-key "\C-xv" map)
  408.     ))
  409.  
  410. ;; FSF menus...
  411. ;; (if (not (boundp 'vc-menu-map))
  412. ;;     ;; Don't do the menu bindings if menu-bar.el wasn't loaded to defvar
  413. ;;     ;; vc-menu-map.
  414. ;;     ()
  415. ;;   ;;(define-key vc-menu-map [show-files]
  416. ;;   ;;  '("Show Files under VC" . (vc-directory t)))
  417. ;;   (define-key vc-menu-map [vc-directory] '("Show Locked Files" . vc-directory))
  418. ;;   (define-key vc-menu-map [separator1] '("----"))
  419. ;;   (define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file))
  420. ;;   (define-key vc-menu-map [vc-version-other-window]
  421. ;;     '("Show Other Version" . vc-version-other-window))
  422. ;;   (define-key vc-menu-map [vc-diff] '("Compare with Last Version" . vc-diff))
  423. ;;   (define-key vc-menu-map [vc-update-change-log]
  424. ;;     '("Update ChangeLog" . vc-update-change-log))
  425. ;;   (define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log))
  426. ;;   (define-key vc-menu-map [separator2] '("----"))
  427. ;;   (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version))
  428. ;;   (define-key vc-menu-map [vc-revert-buffer]
  429. ;;     '("Revert to Last Version" . vc-revert-buffer))
  430. ;;   (define-key vc-menu-map [vc-insert-header]
  431. ;;     '("Insert Header" . vc-insert-headers))
  432. ;;   (define-key vc-menu-map [vc-menu-check-in] '("Check In" . vc-next-action))
  433. ;;   (define-key vc-menu-map [vc-check-out] '("Check Out" . vc-toggle-read-only))
  434. ;;   (define-key vc-menu-map [vc-register] '("Register" . vc-register))
  435. ;;   (put 'vc-rename-file 'menu-enable 'vc-mode)
  436. ;;   (put 'vc-version-other-window 'menu-enable 'vc-mode)
  437. ;;   (put 'vc-diff 'menu-enable 'vc-mode)
  438. ;;   (put 'vc-update-change-log 'menu-enable
  439. ;;        '(eq (vc-backend-deduce (buffer-file-name)) 'RCS))
  440. ;;   (put 'vc-print-log 'menu-enable 'vc-mode)
  441. ;;   (put 'vc-cancel-version 'menu-enable 'vc-mode)
  442. ;;   (put 'vc-revert-buffer 'menu-enable 'vc-mode)
  443. ;;   (put 'vc-insert-headers 'menu-enable 'vc-mode)
  444. ;;   (put 'vc-next-action 'menu-enable '(and vc-mode (not buffer-read-only)))
  445. ;;   (put 'vc-toggle-read-only 'menu-enable '(and vc-mode buffer-read-only))
  446. ;;   (put 'vc-register 'menu-enable '(not vc-mode))
  447. ;;   )
  448.  
  449. ;; #### - sync with fsf menus
  450. (defconst vc-menu
  451.   '("VC"
  452.     :filter vc-menu-filter
  453.     [""                    vc-next-action        buffer-file-name nil]
  454.     ;; ^^^ this gets changed to checkin, checkout, register, or steal
  455.     ["Show status of"              vc-file-status               nil nil]
  456.     ;;["Show Locked Files"       vc-directory t] ;; needs new dired
  457.     "----"
  458.     ["Revert to Last Revision"       vc-revert-buffer            vc-mode nil]
  459.     ["Cancel Last Checkin"       vc-cancel-version        vc-mode]
  460.     ["Rename File"           vc-rename-this-file        vc-mode nil]
  461.     "----"
  462.     ["Diff Against Last Version"   vc-diff            vc-mode]
  463.     ["Diff Between Revisions..."   vc-version-diff        vc-mode]
  464.     ;;["Ediff Between Revisions..."   ediff-revision        vc-mode]
  465.     ["Visit Other Version..."       vc-version-other-window    vc-mode]
  466.     ["Show Edit History"       vc-print-log            vc-mode]
  467.     "----"
  468.     ;; The two commented out List functions simply don't work at the
  469.     ;; moment.
  470.     ;;["List Locked Files"       (vc-directory '(16))        t]
  471.     ["List Locked Files Any User"  vc-directory            t]
  472.     ;;["List Registered Files"       (vc-directory '(4))        t]
  473.     "----"
  474.     ["Create Snapshot"               vc-create-snapshot         t]
  475.     ["Retrieve Snapshot"       vc-retrieve-snapshot        t]
  476.     "----"
  477.     ["CVS Update Directory"          cvs-update                   t] ; pcl-cvs
  478.     ;;["Show File Status"       vc-cvs-file-status        vc-mode]
  479.     )
  480.   "Menubar entry for using the revision control system.")
  481.  
  482. (defun vc-menu-filter (menu-items)
  483.   (let* ((result menu-items)        ; modify in-place
  484.      (case-fold-search t)
  485.      (type (vc-backend-deduce buffer-file-name))
  486.      (file (if buffer-file-name
  487.            (file-name-nondirectory buffer-file-name)
  488.          (buffer-name)))
  489.      op owner item status)
  490.     (setq op (cond ((null type)
  491.             "Register File")
  492.            ((eq type 'CVS)
  493.             (setq status
  494.               (vc-file-getprop buffer-file-name 'cvs-status))
  495.             (if status
  496.             (cdr (assoc status
  497.                     '(("Locally Modified" . "Commit")
  498.                       ("Needs Merge" . "Merge with repository")
  499.                       ("Up-to-date" . "Do nothing to")
  500.                       ("Needs Checkout" . "Update"))))
  501.               ;; #### - we're not gonna call cvs status just to
  502.               ;; post a lousy menu...that's insane!
  503.               "Next action on" 
  504.               ))
  505.            ;; these are all for RCS and SCCS
  506.            ((not (setq owner (vc-file-owner file)))
  507.             ;; #### - ugh!  this is broken.
  508.             ;; vc-file-owner is not a suitable
  509.             ;; substitute for vc-locking-user.
  510.             "Check out File")
  511.            ((not (string-equal owner (user-login-name)))
  512.             "Steal File Lock")
  513.            (t "Check in File")))
  514.     (while (setq item (pop menu-items))
  515.       (and (vectorp item)
  516.        (cond ((eq 'vc-next-action (aref item 1))
  517.           (aset item 0 op)
  518.           (aset item 3 file))
  519.          ((eq 'vc-file-status (aref item 1))
  520.           (aset item 2 (eq 'CVS type))
  521.           (aset item 3 file))
  522.          ((> (length item) 3)
  523.           (aset item 3 file)))))
  524.     result))
  525.  
  526. (add-hook 'before-init-hook
  527.       #'(lambda () (and (featurep 'menubar)
  528.                 (car (find-menu-item current-menubar '("Tools")))
  529.                 (add-submenu '("Tools") vc-menu "Compare"))
  530.           ))
  531.  
  532. (provide 'vc-hooks)
  533.  
  534. ;;; vc-hooks.el ends here
  535.